Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/xreversi/xreversi.frm

Text File | 1995-12-10 | 30KB | 1,053 lines

VERSION 2.00
Begin Form XReversi
   BackColor       =   &H0000FF00&
   Caption         =   "Extended Reversi"
   ClientHeight    =   3960
   ClientLeft      =   1470
   ClientTop       =   1845
   ClientWidth     =   7425
   Height          =   4650
   Icon            =   XREVERSI.FRX:0000
   Left            =   1410
   LinkMode        =   1  'Source
   LinkTopic       =   "Form1"
   ScaleHeight     =   3960
   ScaleWidth      =   7425
   Top             =   1215
   Width           =   7545
   Begin CommandButton buttonHumanForfeit
      Caption         =   "Forfeit Move"
      Height          =   495
      Left            =   5760
      TabIndex        =   7
      Top             =   2160
      Width           =   1215
   End
   Begin CommandButton buttonComputerMove
      Caption         =   "Make Move"
      Height          =   495
      Left            =   4200
      TabIndex        =   6
      Top             =   2160
      Width           =   1215
   End
   Begin PictureBox MoveMsg
      BackColor       =   &H00FFFF00&
      Height          =   975
      Left            =   3960
      ScaleHeight     =   945
      ScaleWidth      =   3225
      TabIndex        =   8
      Top             =   960
      Width           =   3255
   End
   Begin PictureBox Board
      BackColor       =   &H000000FF&
      Height          =   3680
      Left            =   120
      MousePointer    =   2  'Cross
      ScaleHeight     =   3645
      ScaleWidth      =   3645
      TabIndex        =   0
      Top             =   120
      Width           =   3680
   End
   Begin Label HumanScore
      BorderStyle     =   1  'Fixed Single
      Caption         =   "   0"
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   24
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   615
      Left            =   5760
      TabIndex        =   1
      Top             =   3120
      Width           =   1215
   End
   Begin Label ComputerScore
      BorderStyle     =   1  'Fixed Single
      Caption         =   "   0"
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   24
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   615
      Left            =   4200
      TabIndex        =   2
      Top             =   3120
      Width           =   1215
   End
   Begin Label Label2
      BackColor       =   &H0000FF00&
      Caption         =   "Human"
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   12
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   375
      Left            =   5880
      TabIndex        =   5
      Top             =   2760
      Width           =   855
   End
   Begin Label Label1
      BackColor       =   &H0000FF00&
      Caption         =   "Computer"
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   12
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   375
      Left            =   4200
      TabIndex        =   4
      Top             =   2760
      Width           =   1215
   End
   Begin Label FeedbackMsg
      BackColor       =   &H0000FFFF&
      BorderStyle     =   1  'Fixed Single
      Caption         =   " "
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   9.75
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   615
      Left            =   3960
      TabIndex        =   3
      Top             =   120
      Width           =   3255
   End
   Begin Menu menuGame
      Caption         =   "&Game"
      Begin Menu menubarNewGame
         Caption         =   "&New Game"
      End
      Begin Menu menusepG1
         Caption         =   "-"
      End
      Begin Menu menubarModern
         Caption         =   "&Modern Opening"
      End
      Begin Menu menubarRandom
         Caption         =   "&Random Opening"
      End
      Begin Menu menusepG2
         Caption         =   "-"
      End
      Begin Menu menubar8x8
         Caption         =   "&8 x 8 Board"
      End
      Begin Menu menubar10x10
         Caption         =   "&10 x 10 Boad"
      End
      Begin Menu menubar16x16
         Caption         =   "1&6 x 16 Board"
      End
      Begin Menu menubar20x20
         Caption         =   "&20 x 20 Board"
      End
      Begin Menu menusepG3
         Caption         =   "-"
      End
      Begin Menu menubarQuit
         Caption         =   "&Quit"
      End
   End
   Begin Menu menuOptions
      Caption         =   "&Options"
      Begin Menu menubarWhite
         Caption         =   "&White for Human"
      End
      Begin Menu menubarBlack
         Caption         =   "&Black for Human"
      End
      Begin Menu menusepO1
         Caption         =   "-"
      End
      Begin Menu menubarHuman
         Caption         =   "&Human 1st"
      End
      Begin Menu menubarComputer
         Caption         =   "&Computer 1st"
      End
   End
   Begin Menu menuSkill
      Caption         =   "&Skill"
      Begin Menu menubarSkill
         Caption         =   "&Expert Computer"
         Index           =   0
      End
      Begin Menu menubarSkill
         Caption         =   "&Good Computer"
         Index           =   1
      End
      Begin Menu menubarSkill
         Caption         =   "&Fair Computer"
         Index           =   2
      End
      Begin Menu menubarSkill
         Caption         =   "&Poor Computer"
         Index           =   3
      End
      Begin Menu menubarSkill
         Caption         =   "&Idiot Computer"
         Index           =   4
      End
   End
End
DefStr A-Z  ' Force numeric variables to be declared

Dim CRLF$   ' CarriageReturn/LineFeed pair

Dim CurrPlayer As Integer, ModernOpening As Integer  ' Boolean
Dim MoveNoise As Integer

Dim BoardGrid() As String * 1, BoardPc(HUMAN To COMPUTER) As String * 1
Dim DescPc(HUMAN To COMPUTER) As String
Dim Score(HUMAN To COMPUTER) As Integer

Dim TurnNbr As Integer, NbrPcs As Integer
Dim ForfeitCount As Integer
Dim GameOver As Integer  ' Boolean

Dim MaxRC As Integer, MaxIJ As Integer, MidRC As Integer
Dim MaxPcs As Integer

' Raw position values
Dim Rating(MIN_RC To MAX_RATING_RC, MIN_RC To MAX_RATING_RC) As Long

' Multiplier for # turned pieces in line opposite empty square
Dim XEmpty(MIN_RC To MAX_RATING_RC, MIN_RC To MAX_RATING_RC) As Long

' "Neutralize" (neither + nor -) # turned pieces opposite border
Dim XBorder(MIN_RC To MAX_RATING_RC, MIN_RC To MAX_RATING_RC) As Long

' Multiplier for # turned pieces opposite opponent's piece
Dim XOpponent(MIN_RC To MAX_RATING_RC, MIN_RC To MAX_RATING_RC) As Long

' Translation of radial direction value into X and Y coordinate increments
Dim RowIncr(MIN_DIR To MAX_DIR) As Integer
Dim ColIncr(MIN_DIR To MAX_DIR) As Integer

' Adjust scores and total pieces after a move
Sub AdjustScores (ByVal P%, ByVal N%)
    SetScore P%, (Score(P%) + N% + 1)  ' Include new piece
    SetScore (Not P%), (Score(Not P%) - N%)
    NbrPcs = Score(HUMAN) + Score(COMPUTER)
End Sub

' Trigger Human's move on "MouseUp" instead of "Click" to get X & Y
Sub Board_MouseUp (Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim cs As Single
    Dim r%, c%

    cs = CellSize()

    r% = 1 + Int(y / cs)
    c% = 1 + Int(x / cs)

    MoveForHuman r%, c%
End Sub

Sub Board_Paint ()
    ShowGrid
    ShowPcs
End Sub

Sub buttonComputerMove_Click ()